;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "igenerate.lisp")

(require "icommon.lisp")
(require "iimage.lisp")

(module MGenerate
  (import IImage)
  (import ICommon)
  
  
  (defun SolidHelper(tree width height r g b x y)
    (let* ((nextX (getNextXCoordinate x width))
           (nextY (getNextYCoordinate x y width)))
        (if (isValidPixel nextX nextY width height)
            (SolidHelper (insertPixel tree x y r g b) width height r g b nextX nextY)
            (insertPixel tree x y r g b))))
    
  (defun Solid(tree r g b)
    (mv (SolidHelper tree (getWidth tree) (getHeight tree) r g b 1 (getHeight tree)) nil))
  
  
  
  (defun DrawRowHelper (tree row x width red green blue)
    (if (> x width)
        tree
        (DrawRowHelper (insertPixel tree x row red green blue) row (+ x 1) width red green blue)))
    
  (defun DrawRow (tree row red green blue)
    (DrawRowHelper tree row 1 (GetWidth tree) red green blue))
  
  (defun DrawColumnHelper (tree col y height red green blue)
    (if (> y height)
        tree
        (DrawColumnHelper (insertPixel tree col y red green blue) col (+ y 1) height red green blue)))
    
  (defun DrawColumn (tree col red green blue)
    (DrawColumnHelper tree col 1 (GetHeight tree) red green blue))
   
  
  (defun LinearGradientHorizontalHelper(tree start length col width red green blue redInc greenInc blueInc)
    (let* ((newRed   (if (and (>= col start)(< (- col start) length)) (+ red redInc) red))
           (newGreen (if (and (>= col start)(< (- col start) length)) (+ green greenInc) green))
           (newBlue  (if (and (>= col start)(< (- col start) length)) (+ blue blueInc) blue)))
      (if (> col width)
          tree
          (LinearGradientHorizontalHelper (DrawColumn tree col (round red 1) (round green 1) (round blue 1))
                                                  start length (+ col 1) width newRed newGreen newBlue redInc greenInc blueInc))))
  
  (defun LinearGradientHorizontal(tree start length red1 green1 blue1 red2 green2 blue2)
    (let* ((width    (getWidth tree))
           (redInc   (/ (- red2   red1)   length))
           (blueInc  (/ (- blue2  blue1)  length))
           (greenInc (/ (- green2 green1) length)))
      (mv (LinearGradientHorizontalHelper tree start length 1 width red1 green1 blue1 redInc greenInc blueInc) (list "Successfully generated horizontal gradient."))))
                  
      
  
  
   (defun LinearGradientVerticalHelper(tree start length row height red green blue redInc greenInc blueInc)
    (let* ((newRed   (if (and (>= row start)(< (- row start) length)) (+ red redInc) red))
           (newGreen (if (and (>= row start)(< (- row start) length)) (+ green greenInc) green))
           (newBlue  (if (and (>= row start)(< (- row start) length)) (+ blue blueInc) blue)))
      (if (> row height)
          tree
          (LinearGradientVerticalHelper (DrawRow tree row (round red 1) (round green 1) (round blue 1))
                                                  start length (+ row 1) height newRed newGreen newBlue redInc greenInc blueInc))))

  
  (defun LinearGradientVertical(tree start length red1 green1 blue1 red2 green2 blue2)
    (let* ((height   (getHeight tree))
           (redInc   (/ (- red2   red1)   length))
           (blueInc  (/ (- blue2  blue1)  length))
           (greenInc (/ (- green2 green1) length)))
      (mv (LinearGradientVerticalHelper tree start length 1 height red1 green1 blue1 redInc greenInc blueInc) (list "Successfully generated vertical gradient."))))
                                                  
  (defun LinearGradient(tree direction start length red1 green1 blue1 red2 green2 blue2)
    (if (string-equal direction "HORIZONTAL")
        (LinearGradientHorizontal tree start length red1 green1 blue1 red2 green2 blue2)
        (if (string-equal direction "VERTICAL")
            (LinearGradientVertical tree start length red1 green1 blue1 red2 green2 blue2)
            (mv tree (list "Invalid gradient type.")))))
  
  (defun InCircle(x y centerX centerY radius)
    (> (square radius)
       (+ (square (- x centerX))
          (square (- y centerY)))))
  
  (defun DistanceSquared(x1 y1 x2 y2)
    (+ (square (- x2 x1)) (square (- y2 y1))))
  
  
  (defun CircularGradientInsertion(tree x y centerX centerY radius redInitial greenInitial blueInitial redInc greenInc blueInc)
        (if (InCircle x y centerX centerY radius)
            (let* ((distSquared (DistanceSquared centerX centerY x y))
                   (multiplier (* (/ distSquared (square radius)) radius))
                   (newRed   (Cap (+ redInitial   (* redInc multiplier))   0 255))
                   (newGreen (Cap (+ greenInitial (* greenInc multiplier)) 0 255))
                   (newBlue  (Cap (+ blueInitial  (* blueInc multiplier))  0 255)))
              (insertPixel tree x y (round newRed 1) (round newGreen 1) (round newBlue 1)))
            (insertPixel tree x y (round (+ redInitial (* redInc radius)) 1) (round (+ greenInitial (* greenInc radius)) 1) (round (+ blueInitial (* blueInc radius)) 1)))) 
    
  
  (defun CircularGradientHelper(tree x y centerX centerY radius width height redInitial greenInitial blueInitial redInc greenInc blueInc)
    (let* ((nextX (getNextXCoordinate x width))
           (nextY (getNextYCoordinate x y width)))
      (if (isValidPixel x y width height)
          (CircularGradientHelper (CircularGradientInsertion tree x y centerX centerY radius redInitial greenInitial blueInitial redInc greenInc blueInc)
                                   nextX nextY centerX centerY radius width height redInitial greenInitial blueInitial redInc greenInc blueInc)
          tree)))
          
  (defun CircularGradient(tree x y radius red1 green1 blue1 red2 green2 blue2)
        (let* ((width    (getWidth tree))
               (height   (getHeight tree))
               (redInc   (/ (- red2   red1)   radius))
               (blueInc  (/ (- blue2  blue1)  radius))
               (greenInc (/ (- green2 green1) radius)))
          (mv (CircularGradientHelper tree 1 height x y radius width height red1 green1 blue1 redInc greenInc blueInc) (list "Successfully generated circular gradient.")))) 
  
  
  (defun FillSpaceHorizontalLine(tree x y spaceWidth r g b)
    (if (equal spaceWidth 0)
        tree
        (FillSpaceHorizontalLine (insertPixel tree x y r g b) (+ x 1) y (- spaceWidth 1) r g b)))
       
    
  (defun FillSpaceLines(tree x y spaceWidth spaceHeight r g b)
    (if (equal spaceHeight 0)
        tree
        (FillSpaceLines (FillSpaceHorizontalLine tree x y spaceWidth r g b) x (+ y 1) spaceWidth (- spaceHeight 1) r g b)))

  
  (defun FillSpace(tree x y spaceWidth spaceHeight r g b)
    (let* ((width (getWidth tree))
           (height (getHeight tree))
           (truncatedSpaceWidth (if (> (+ x spaceWidth) width)
                                   (+ (- width x) 1)
                                   spaceWidth))
           (truncatedSpaceHeight (if (> (+ y spaceHeight) height)
                                   (+ (- height y) 1)
                                   spaceHeight)))
      (FillSpaceLines tree x y truncatedSpaceWidth truncatedSpaceHeight r g b)))
  
  (defun FillSpacesRow (tree spaceX spaceY spaceWidth spaceHeight r1 g1 b1 r2 g2 b2 color1)
    (let* ((r (if color1 r1 r2))
           (g (if color1 g1 g2))
           (b (if color1 b1 b2))
           (width (getWidth tree))
           (newX (+ spaceX spaceWidth)))  
      (if (> spaceX width)
          tree
          (FillSpacesRow (FillSpace tree spaceX spaceY spaceWidth spaceHeight r g b) newX spaceY spaceWidth spaceHeight r1 g1 b1 r2 g2 b2 (not color1)))))
  
  (defun FillSpacesRows (tree spaceX spaceY spaceWidth spaceHeight r1 g1 b1 r2 g2 b2 color1)
    (let* ((height (getHeight tree))
           (newY (+ spaceY spaceHeight)))
      (if (> spaceY height)
          tree
          (FillSpacesRows (FillSpacesRow tree spaceX spaceY spaceWidth spaceHeight r1 g1 b1 r2 g2 b2 color1) spaceX newY spaceWidth spaceHeight r1 g1 b1 r2 g2 b2 (not color1)))))
            
     

  

  
  (defun CheckerBoard(tree spaceWidth spaceHeight r1 g1 b1 r2 g2 b2)
    (mv (FillSpacesRows tree 1 1 spaceWidth spaceHeight r1 g1 b1 r2 g2 b2 t) (list "Successfully generated checkerboard.")))
  
  (defun HorizontalInterlace(tree height r1 g1 b1 r2 g2 b2)
    (mv (car (CheckerBoard tree (getWidth tree) height r1 g1 b1 r2 g2 b2)) (list "Successfully generated horizontal interlace.")))
  
  (defun VerticalInterlace(tree width r1 g1 b1 r2 g2 b2)
    (mv (car (CheckerBoard tree width (getHeight tree) r1 g1 b1 r2 g2 b2)) (list "Successfully generated vertical interlace.")))
  
  (defun MainGenerate(tree args)
    (let* ((type      (getElement args 1)))
      (cond
        ((string-equal type "SOLID")
         (let* ((red   (getElement args 2))
                (green (getElement args 3))
                (blue  (getElement args 4)))
           (Solid tree red green blue)))
        ((string-equal type "LINEARGRADIENT")
         (let* ((direction (getElement args 2))
                (start     (getElement args 3))
                (length    (getElement args 4))
                (red1      (getElement args 5))
                (green1    (getElement args 6))
                (blue1     (getElement args 7))
                (red2      (getElement args 8))
                (green2    (getElement args 9))
                (blue2     (getElement args 10)))
           (LinearGradient tree direction start length red1 green1 blue1 red2 green2 blue2)))
        ((string-equal type "CIRCULARGRADIENT")
         (let* ((x      (getElement args 2))
                (y      (getElement args 3))
                (radius (getElement args 4))
                (red1   (getElement args 5))
                (green1 (getElement args 6))
                (blue1  (getElement args 7))
                (red2   (getElement args 8))
                (green2 (getElement args 9))
                (blue2  (getElement args 10)))
           (CircularGradient tree x y radius red1 green1 blue1 red2 green2 blue2)))
        ((string-equal type "CHECKERBOARD")
         (let* ((spaceWidth  (getElement args 2))
                (spaceHeight (getElement args 3))
                (red1        (getElement args 4))
                (green1      (getElement args 5))
                (blue1       (getElement args 6))
                (red2        (getElement args 7))
                (green2      (getElement args 8))
                (blue2       (getElement args 9)))
           (CheckerBoard tree spaceWidth spaceHeight red1 green1 blue1 red2 green2 blue2)))
        ((string-equal type "INTERLACEHORIZONTAL")
         (let* ((height      (getElement args 2))
                (red1        (getElement args 3))
                (green1      (getElement args 4))
                (blue1       (getElement args 5))
                (red2        (getElement args 6))
                (green2      (getElement args 7))
                (blue2       (getElement args 8)))
           (HorizontalInterlace tree height red1 green1 blue1 red2 green2 blue2)))
        ((string-equal type "INTERLACEVERTICAL")
         (let* ((width       (getElement args 2))
                (red1        (getElement args 3))
                (green1      (getElement args 4))
                (blue1       (getElement args 5))
                (red2        (getElement args 6))
                (green2      (getElement args 7))
                (blue2       (getElement args 8)))
           (VerticalInterlace tree width red1 green1 blue1 red2 green2 blue2))))))
       
  
  
  (export IGenerate))
  